home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FishMarket 1.0
/
FishMarket v1.0.iso
/
fishies
/
501-525
/
disk_503
/
pcq
/
pcq12a.lzh
/
Examples
/
BobTest.p
< prev
next >
Wrap
Text File
|
1991-06-09
|
7KB
|
270 lines
Program BOBTest;
{
This program is based on BobTest.c from the original RKM
example set. It simply creates a BOB, then moves it
around the window until you close the window.
}
{$I "Include:Graphics/Gfx.i"}
{$I "Include:Graphics/Rastport.i"}
{$I "Include:Graphics/View.i"}
{$I "Include:Exec/Exec.i"}
{$I "Include:Graphics/Gels.i"}
{$I "Include:Intuition/Intuition.i"}
{$I "Include:Graphics/Graphics.i"}
{$I "Include:Graphics/Pens.i"}
Const
ScreenDepth = 3;
ObjectWidth = 48; { Three words wide }
ObjectHeight = 30; { Thirty lines tall }
ObjectWords = (ObjectWidth + 15) div 16;
Memory_Flags = MEMF_PUBLIC or MEMF_CHIP or MEMF_CLEAR;
Var
w : WindowPtr;
s : ScreenPtr;
rp : RastPortPtr;
vp : ViewPortPtr;
Const
TestFont : TextAttr = ("topaz.font", 8, 0, 0);
ns : NewScreen = (
0,0, { start position }
320, 200, ScreenDepth,
0, 1, { detail pen, block pen }
0, { viewing mode (was HIRES) }
CUSTOMSCREEN_f, { screen type }
@TestFont, { font to use }
"GELS Example Program", { default title for screen }
Nil, { pointer to additional gadgets }
Nil
);
WINDOWFLAGS = GIMMEZEROZERO or WINDOWDRAG or WINDOWSIZING or
WINDOWDEPTH or WINDOWCLOSE or ACTIVATE;
nw : NewWindow = (
20, 20, { start position }
220, 150, { width, height }
-1, -1, { detail pen, block pen }
CLOSEWINDOW_f, { IDCMP flags }
WINDOWFLAGS, { window flags }
Nil, { pointer to first user gadget }
Nil, { pointer to user checkmark }
"Bouncing BOB", { window title }
Nil, { pointer to screen (later) }
Nil, { pointer to superbitmap }
30,20,-1,-1, { sized window }
CUSTOMSCREEN_f { type of screen in which to open }
);
var
s1, s2 : VSprite; { dummy sprites for gels list }
mygelsinfo : GelsInfo; { gelsinfo to link into system rastport }
collisiontable : collTable;
v : VSprite;
b : Bob;
i : Short;
UsedMemory : RememberPtr;
BorderMask, { Used for detecting collisions with border }
CMask, { Collision, or shadow, mask }
Images, { The actual image data }
BackBuffer : ^Array [0..MaxInt] of Short;
xspeed : Short;
yspeed : Short;
Function GetGfxMem(size : Integer) : Address;
var
Result : Address;
begin
Result := AllocRemember(UsedMemory,size,Memory_Flags);
if Result = Nil then begin
CloseWindow(w);
CloseScreen(s);
CloseLibrary(GfxBase);
FreeRemember(UsedMemory,True);
Writeln('Could not allocate memory');
Exit(20);
end;
GetGfxMem := Result;
end;
Procedure InitializeBOB;
begin
with MyGelsInfo do begin
nextLine := Nil;
lastColor := Nil;
collHandler := @collisiontable;
end;
InitGels(@s1, @s2, @MyGelsInfo);
rp^.GelsInfo := @MyGelsInfo;
with v do begin
X := 20;
Y := 4;
Flags := OVERLAY + SAVEBACK;
Height := ObjectHeight;
Width := ObjectWords;
Depth := ScreenDepth;
MeMask := 1;
HitMask := 1;
Images := GetGfxMem(ObjectWords * ObjectHeight * ScreenDepth * 2);
BackBuffer := GetGfxMem(Succ(ObjectWords) * ObjectHeight * ScreenDepth * 2);
CMask := GetGfxMem(ObjectWords * ObjectHeight * 2);
BorderMask := GetGfxMem(ObjectWords * 2);
{ Set first bit plane like: 1 0 1 }
{ 1 0 1 }
{ 1 0 1 }
for i := 0 to Pred(ObjectHeight) do begin
Images^[i*ObjectWords] := $FFFF;
Images^[i*ObjectWords + 2] := $FFFF;
end;
{ Set second bit plane like: 0 1 1 }
{ 0 1 1 }
{ 0 1 1 }
for i := ObjectHeight to Pred(ObjectHeight * 2) do begin
Images^[i*ObjectWords+1] := $FFFF;
Images^[i*ObjectWords+2] := $FFFF;
end;
ImageData := Images; { Point VSprite to image data }
CollMask := CMask; { Point to collision mask area }
BorderLine := BorderMask; { Point to border mask area }
InitMasks(@v); { Set up collision & border masks }
PlanePick := $03; { Just use first two planes }
PlaneOnOff := 4; { Set third plane solid }
end;
{ ****************** now initialize the Bob variables ******* }
with b do begin
Flags := 0;
SaveBuffer := BackBuffer; { show where to save background }
ImageShadow := CMask; { collision and shadow are same }
Before := Nil; { dont care about drawing order }
After := Nil;
BobComp := Nil; { not animation component }
DBuffer := Nil; { not double buffered }
BobVSprite := @v; { link to the VSprite }
end;
v.VSBob := @b; { Link the VSprite to the BOB }
AddBob(@b, rp); { Add to the GELS list }
SortGList(rp); { Sort it for drawing }
WaitTOF; { Sync with beam }
DrawGList(rp,vp); { Draw the BOBs, etc. }
end;
Procedure MoveBOB;
var
M : MessagePtr;
begin
while true do begin
Inc(b.BobVSprite^.Y,yspeed);
if b.BobVSprite^.Y > (w^.GZZHeight - ObjectHeight) then
yspeed := -yspeed
else
Inc(yspeed);
Inc(b.BobVSprite^.X,xspeed);
if (b.BobVSprite^.X >= (w^.GZZWidth - ObjectWidth)) or
(b.BobVSprite^.X <= 0) then
xspeed := -xspeed;
SortGList(rp);
WaitTOF;
DrawGList(rp,vp);
M := GetMsg(w^.UserPort);
if M <> Nil then begin
ReplyMsg(M);
return;
end;
end;
end;
Procedure Setup;
var
i : Short;
p : Byte;
begin
UsedMemory := Nil; { To keep track of allocations }
GfxBase := OpenLibrary("graphics.library", 0);
if GfxBase = Nil then begin
Writeln("Unable to open graphics library");
exit(20);
end;
s := OpenScreen(@ns);
nw.Screen := s;
w := OpenWindow(@nw); { open a window }
rp := w^.RPort;
vp := ViewPortAddress(w);
xspeed := 2;
yspeed := 0;
SetRGB4(vp,5, 0, 0,12); { Set flag colors to blue...}
SetRGB4(vp,6,15,15,15); { white }
SetRGB4(vp,7,12, 0, 0); { red }
{ Draw some sort of pattern in the window to show that }
{ we aren't messing it up. }
p := 1;
SetAPen(rp,p);
for i := 0 to w^.GZZWidth do begin
Move(rp,i,0);
Draw(rp,w^.GZZWidth - i,w^.GZZheight);
p := Succ(p) and 3;
SetAPen(rp,p);
end;
for i := 0 to w^.GZZheight do begin
Move(rp, 0, i);
Draw(rp, w^.GZZWidth, w^.GZZheight - i);
p := Succ(p) and 3;
SetAPen(rp,p);
end;
end;
begin
SetUp;
InitializeBOB;
MoveBOB;
RemBob(@b);
FreeRemember(UsedMemory,True);
CloseWindow(w);
CloseScreen(s);
CloseLibrary(GfxBase);
end.